home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Light ROM 1
/
LIGHT-ROM 1 (Amiga Library Services)(1994).iso
/
ffdisks
/
d949.lha
/
BBBBS
/
BBBBS65.lha
/
rexx
/
ArcBrowse.rexx
< prev
next >
Wrap
OS/2 REXX Batch file
|
1993-07-31
|
8KB
|
319 lines
/* $VER: ArcBrowse.rexx 6.2 © 1993 Richard Lee Stockton (31.7.93)
archives user defined browselist into file in users email
it receives its arguments from rexxDoors/Make_BrowseList.rexx
copyright 1991-93 Richard Lee Stockton FREELY DISTRIBUTABLE
*/
CALL TIME('R')
SIGNAL ON ERROR
SIGNAL ON SYNTAX
OPTIONS FAILAT 999999
PARSE ARG name lastbrowse alphaflag libflag liblist
lastbrowse=STRIP(lastbrowse)
CALL CLOSE(STDOUT)
CALL OPEN(STDOUT,'RAM:ArcBrowse.STDOUT','W')
SAY STRIP(SUBSTR(SOURCELINE(1),3))
SAY
IF ~DATATYPE(lastbrowse,'N') | name='' | alphaflag='' | libflag='' | liblist='' THEN
CALL GETOUT(20)
figarg='s:CONFIG.BBS'
IF ~EXISTS(figarg) THEN figarg='BBS:BBS_TEXT/CONFIG.BBS'
x=OPEN(f,figarg,'R')
IF x=0 THEN
DO
SAY 's:CONFIG.BBS and BBS:BBS/CONFIG.BBS are both missing!'
CALL GETOUT(21)
END
lynes.=''
DO i=1 TO 33
lynes.i=READLN(f)
END
CALL CLOSE(f)
compos=POS('/*',lynes.1)
IF compos>0 THEN lynes.1=LEFT(lynes.1,compos-1)
bbsname = STRIP(lynes.1)
sysop = WORD(lynes.2,1)
bbspath = WORD(lynes.6,1)
IF ~EXISTS(bbspath) THEN
DO
SAY bbspath 'does not exist!'
CALL GETOUT(22)
END
testchar=RIGHT(bbspath,1)
IF testchar~='/' & testchar~=':' THEN bbspath=bbspath'/'
DO i=1
IF GETCLIP('BBS_BROWSE'i)='' THEN /* info clip for external STOP */
DO
CALL SETCLIP('BBS_BROWSE'i,name)
CALL SETCLIP('BBS_STOP_BROWSE'i)
clipnum=i
LEAVE i
END
END
CALL PRAGMA('P',-4) /* lower the priority of this task */
extension=WORD(lynes.32,1)
compos=POS('/*',lynes.33)
IF compos>0 THEN lynes.33=LEFT(lynes.33,compos-1)
arccom=STRIP(lynes.33)
IF LEFT(extension,1)~='.' THEN
DO
extension='.lzh'
arccom='lha -m m'
END
filepath=bbspath'EmailFiles/'name
CALL MAKEDIR(filepath)
IF GETCLIP('BBS_'name)~='' THEN browsename=filepath'/FileList'
ELSE
DO
x=OPEN(f,bbspath'Numbers/LastMail','R')
IF x~=0 THEN lastm=READLN(f)+1
CALL CLOSE(f)
ADDRESS COMMAND 'ECHO >'bbspath'Numbers/LastMail 'lastm
browsename=filepath'/BBBBS_'lastm
END
filelistname=bbspath'Lists/Files'
filelist.=''
x=OPEN(f,filelistname,'R')
IF x=0 THEN CALL GETOUT(23)
DO i=1
line=READLN(f)
IF EOF(f) THEN LEAVE i
indx=WORD(line,1)
IF DATATYPE(indx,'N') THEN filelist.indx=line
END
filelist.0=indx
CALL CLOSE(f)
numba=filelist.0
IF alphaflag='A' THEN
DO
filelistname=filelistname'.ALPHA'
alphalist.=''
x=OPEN(f,filelistname,'R')
IF x=0 THEN CALL GETOUT(24)
DO i=1
line=READLN(f)
IF EOF(f) THEN LEAVE i
alphalist.i=line
END
alphalist.0=i-1
CALL CLOSE(f)
numba=alphalist.0
END
oldt=0
count=0
archives=1
CALL open_browse()
IF libflag='A' THEN CALL noteloop(1)
ELSE IF libflag='L' THEN
DO j=1 TO WORDS(liblist)
test1=WORD(liblist,j)
CALL noteloop(0)
END
IF WORD(STATEF(browsename),2)<80 THEN CALL GETOUT(26)
IF GETCLIP('BBS_'name)~='' THEN CALL GETOUT(0)
CALL write_msg()
CALL GETOUT(0)
EXIT
add_note:
ARG addname
count=count+1
IF count//5=0 THEN
DO
t=GETCLIP('BBS_STOP_BROWSE'clipnum)
IF t~='' THEN CALL cleanup(t)
END
finfo=STATEF(browsename)
IF WORD(finfo,2)>1400000 THEN
DO
CALL write_msg()
archives=archives+1
x=OPEN(a,browsename,'A')
IF x=0 THEN CALL GETOUT(33)
CALL WRITELN(a,CENTER('=== continued in part' archives'. ===',75))
CALL CLOSE(a)
CALL DELAY(50)
IF GETCLIP('BBS_'name)~='' THEN
DO
IF EXISTS('FileList') THEN CALL RENAME('FileList','List1')
browsename=filepath'/List'archives
END
ELSE
DO
x=OPEN(f,bbspath'Numbers/LastMail','R')
IF x~=0 THEN lastm=READLN(f)+1
ELSE lastm=lastm+1
CALL CLOSE(f)
ADDRESS COMMAND 'echo >'bbspath'Numbers/LastMail 'lastm
browsename=filepath'/BBBBS_'lastm
END
CALL open_browse()
END
x=OPEN(a,browsename,'A')
IF x=0 THEN CALL GETOUT(30)
CALL WRITELN(a,'=====')
x=OPEN(b,addname,'R')
IF x=0 THEN CALL WRITELN(a,addname 'failed to open for reading!')
ELSE
DO
data=READCH(b,65000)
CALL CLOSE(b)
CALL WRITECH(a,data)
END
CALL WRITELN(a,'')
CALL CLOSE(a)
RETURN
write_msg:
IF GETCLIP('BBS_'name)~='' THEN RETURN
CALL PRAGMA('P',0) /* normal priority */
ADDRESS COMMAND arccom browsename||extension browsename
IF ~EXISTS(browsename||extension) THEN CALL GETOUT(27)
CALL PRAGMA('P',-4)
x=OPEN(f,bbspath'Email/'name'/BBBBS.'lastm,'W')
IF x=0 THEN CALL GETOUT(28)
CALL WRITELN(f,' Mail: 'lastm' FILE: BBBBS_'lastm||extension)
CALL WRITELN(f,' From: BBBBS')
CALL WRITELN(f,' To: 'name)
temp='BrowseList'
IF WORD(finfo,2)>1400000 THEN temp=temp', part' archives
CALL WRITELN(f,' Subj:' temp)
CALL WRITELN(f,' Date: 'DATE('W') DATE() TIME('C'))
CALL WRITELN(f,LEFT('=',75,'='))
temp='Here are the file descriptions you requested'
IF WORD(finfo,2)>1400000 THEN temp=temp', part' archives
CALL WRITELN(f,temp'.')
t=(.5+TIME('E'))%1
t=t-oldt
oldt=t+oldt
min=t%60
hrs=min%60
min=min//60
sec=t//60
temp='It took'
IF hrs>1 THEN temp=temp hrs 'hours'
ELSE IF hrs=1 THEN temp=temp '1 hour'
IF min>1 THEN temp=temp min 'minutes'
ELSE IF min=1 THEN temp=temp '1 minute'
IF sec=1 THEN temp=temp '1 second'
ELSE IF sec>0 THEN temp=temp sec 'seconds'
temp=temp 'to compile these descriptions.'
CALL WRITELN(f,temp)
CALL CLOSE(f)
IF GETCLIP('BBS_level')~='' & WORD(GETCLIP('BBS_lastcaller'),1)=name THEN
DO
oldmess=GETCLIP('BBS_MESSAGE')
IF oldmess~='' THEN oldmess=oldmess||'0D0A'x
CALL SETCLIP('BBS_MESSAGE',oldmess||'Your archived filelist is waiting in Email.')
END
RETURN
open_browse:
x=OPEN(a,browsename,'W')
IF x=0 THEN CALL GETOUT(25)
IF alphaflag='A' THEN temp='alphabetical'
ELSE temp='aged'
title='=' bbsname temp 'file descriptions'
IF libflag='L' THEN title=title 'by library'
IF archives>1 THEN title=title', part' archives
CALL WRITELN(a,title)
CALL WRITELN(a,'= Custom archived for' name' 'DATE() TIME('C'))
CALL WRITELN(a,'')
CALL CLOSE(a)
IF GETCLIP('BBS_'name)='' THEN
DO
x=OPEN(f,bbspath'Email/'name'/BBBBS.'lastm,'W')
IF x=0 THEN CALL GETOUT(28)
CALL WRITELN(f,' Mail: 'lastm' FILE: BBBBS_'lastm)
CALL WRITELN(f,' From: BBBBS')
CALL WRITELN(f,' To: 'name)
CALL WRITELN(f,' Subj: BrowseList')
CALL WRITELN(f,' Date: 'DATE('W') DATE() TIME('C'))
CALL WRITELN(f,LEFT('=',75,'='))
CALL WRITELN(f,'Here are the file descriptions you requested.')
CALL WRITELN(f,'The collection process was interrupted.')
CALL CLOSE(f)
END
RETURN
noteloop:
ARG nflag .
IF alphaflag='A' THEN
DO i=1 TO numba
k=i
k=STRIP(WORD(alphalist.i,3))
IF filelist.k='' | lastbrowse>=k THEN ITERATE i
lname=WORD(filelist.k,2)
fname=WORD(filelist.k,3)
IF nflag THEN
DO
IF FIND(UPPER(liblist),UPPER(lname))=0 THEN ITERATE i
END
ELSE IF UPPER(test1)~=UPPER(lname) THEN ITERATE i
CALL add_note(bbspath'FileNotes/'lname'/'fname)
END
ELSE
DO i=numba TO 1 BY -1
IF filelist.i='' | lastbrowse>=i THEN ITERATE i
lname=WORD(filelist.i,2)
fname=WORD(filelist.i,3)
IF nflag THEN
DO
IF FIND(UPPER(liblist),UPPER(lname))=0 THEN ITERATE i
END
ELSE IF UPPER(test1)~=UPPER(lname) THEN ITERATE i
CALL add_note(bbspath'FileNotes/'lname'/'fname)
END
RETURN
cleanup:
ARG t2 .
SAY 'User aborted!'
IF t2='DELETE' THEN
DO
IF GETCLIP('BBS_'name)~='' THEN
DO
CALL DELETE(bbspath'EmailFiles/'name'/FileList')
ADDRESS COMMAND 'c:delete' bbspath'EmailFiles/'name'/List#?'
END
ELSE ADDRESS COMMAND 'c:delete' LEFT(browsename,LENGTH(browsename)-4)'#?'
END
CALL GETOUT(0)
RETURN
ERROR:
SYNTAX:
GETOUT:
ARG errorout
CALL SETCLIP('BBS_BROWSE')
CALL SETCLIP('BBS_BROWSE'clipnum)
CALL SETCLIP('BBS_STOP_BROWSE'clipnum)
IF errorout>0 THEN SAY 'ArcBrowse error' errorout'!'
EXIT(errorout)
/* ArcBrowse.rexx */